home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Compute! Gazette 1985 November
/
1985-11.d64
/
power poker
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-09-20
|
6KB
|
165 lines
100 print"[147]"chr$(8):tv=1:x=53280:rem ** set tv to 1 for color tv
110 iftv=1thenpokex,5:pokex+1,5:pokex+2,13:pokex+3,1:pokex+4,5:goto130
120 pokex,12:pokex+1,12:pokex+2,15:pokex+3,1:pokex+4,12
130 dimh1(35),h2(35),sm(30),e(29),ck(25,25),j1(25),j2(25),ca(14)
140 a$="":b$="":hs=0
150 gosub470:print"[147]"
160 printchr$(144)spc(8)"poker hand point values"
170 printspc(11)"royal flush...400":printspc(11)"str flush.....300"
180 printspc(11)"4 of a kind...160":printspc(11)"straight......120"
190 printspc(11)"full house....100":printspc(11)"3 of a kind....60"
200 printspc(11)"flush..........50":printspc(11)"two pair.......30"
210 printspc(11)"one pair.......10"
220 printchr$(19)chr$(5)a$spc(13)"loading data"
230 fori=1to573:reada:t=t+a:next
240 ift<>113126thenprint"error in data statements.":stop
250 restore:poke56334,peek(56334)and254:poke1,peek(1)and251
260 fori=0to511:pokei+14336,peek(i+53248):next
270 poke1,peek(1)or4:poke56334,peek(56334)or1
280 forx=14336to14343:reada:pokex,a:next
290 forx=14552to14591:reada:pokex,a:next
300 forx=14640to14703:reada:pokex,a:next
310 forx=14808to14839:reada:pokex,a:next
320 forx=1to4:readsu(x):readco(x):next
330 forx=2to14:readca(x):next
340 forx=5to30:readsm(x):msb=int(sm(x)/256):lsb=sm(x)-(msb*256)
350 poke823+x,lsb:poke850+x,msb:next
360 forx=49152to49533:readml:pokex,ml:next
370 poke53272,(peek(53272)and240)or14
380 poke53265,peek(53265)or64:goto500
390 d$=str$(hs):printchr$(19)a$b$spc(9)"h s"
400 iflen(d$)=2thenprintb$spc(10)d$"[157][157][157]00"chr$(5):return
410 iflen(d$)=3thenprintb$spc(9)d$"[157][157][157]0"chr$(5):return
420 printb$spc(8)hschr$(5):return
430 d$=str$(sc):printchr$(19)a$b$"score"
440 iflen(d$)=2thenprintb$spc(2)d$"[157][157][157]00":return
450 iflen(d$)=3thenprintb$spc(1)d$"[157][157][157]0":return
460 printb$sc:return
470 poke53272,(peek(53272)and15)or240:poke648,60:return
480 geti$:ifi$=""then480
490 poke53272,(peek(53272)and15)or16:poke648,4:return
500 printchr$(19)chr$(5)a$spc(13)" shuffling ":forx=1to25
510 j1(x)=int(rnd(.)*13)+2:j2(x)=int(rnd(0)*4)+1:ifck(j1(x),j2(x))=1then510
520 ck(j1(x),j2(x))=1:e(x+4)=0:next
530 sc=0:nh=0:printchr$(19)a$spc(13)" ":gosub490
540 printchr$(147):sys49194:printchr$(144):gosub390:gosub430
550 printb$chr$(144)"press f1 for":printb$"[145]point values"
560 forn=1to25:poke781,30:sys49166
570 poke251,ca(j1(n)):poke252,su(j2(n)):poke10,co(j2(n)):poke781,30:sys49297
580 poke198,0
590 geti$:ifi$=""then590
600 ifi$="[133]"thensys49449:gosub470:gosub480:sys49502:goto580
610 h=asc(i$)-60:ifh<5orh>29then580
620 ife(h)=1then580
630 e(h)=1:h1(h)=j1(n):poke781,30:sys49180
640 poke781,h:sys49166:poke883+h,co(j2(n))
650 poke251,ca(j1(n)):poke252,su(j2(n)):poke10,co(j2(n)):poke781,h:sys49297
660 row=int(h/5)*5:a=row:b=a+4:bx=0:forx=atob:ife(x)=1thenbx=bx+1
670 next:ifbx=5thengosub790
680 a=(h-row)+5:b=a+20:by=0:forx=atobstep5:ife(x)=1thenby=by+1
690 next:ifby=5thengosub900
700 ck(j1(n),j2(n))=0:nextn:ifsc>hsthenhs=sc:nh=1
710 printchr$(19)b$" play again":fort=1to300:next
720 ifnh=1thenpoke646,peek(53281):gosub390
730 printchr$(19)b$" y or n ":fort=1to300:next
740 ifnh=1thenprintchr$(144):gosub390
750 geti$:ifi$="y"thenprintchr$(147):sys49449:gosub470:goto500
760 ifi$="n"then780
770 goto710
780 poke53265,27:poke53272,21:printchr$(147)chr$(144):end
790 l=0:r=0:k=0:cs=0:p=1
800 forx=atob:h2(x)=h1(x):cs=cs+h1(x):l=l+peek(sm(x)+82):next
810 h2(b+1)=0:forx=atob:forxx=atob
820 ifh2(xx)<h2(x)thenc=h2(x):h2(x)=h2(xx):h2(xx)=c
830 next:next:forx=atob:poke882+p,0:forxx=atob
840 ifh1(xx)=h1(x)thenk=k+1:ifxx<>xthenpoke882+p,x
850 next:p=p+1:next:h2(a-1)=0:forx=atob:ifh2(x-1)=1+h2(x)thenr=r+1
860 next:ifr=4thengosub890
870 ifl/5=peek(sm(b)+82)thengosub890:goto1080
880 goto1000
890 ss=1-(b-a=20)*4:p=1:forx=atobstepss:poke882+p,x:p=p+1:next:return
900 l=0:r=0:k=0:cs=0:p=1
910 forx=atobstep5:h2(x)=h1(x):cs=cs+h1(x):l=l+peek(sm(x)+82):next
920 h2(b+5)=0:forx=atobstep5:forxx=atobstep5
930 ifh2(xx)<h2(x)thenc=h2(x):h2(x)=h2(xx):h2(xx)=c
940 next:next:forx=atobstep5:poke882+p,0:forxx=atobstep5
950 ifh1(xx)=h1(x)thenk=k+1:ifxx<>xthenpoke882+p,x
960 next:p=p+1:next:h2(a-5)=0:forx=atobstep5:ifh2(x-5)=1+h2(x)thenr=r+1
970 next:ifr=4thengosub890
980 ifl/5=peek(sm(b)+82)thengosub890:goto1080
990 goto1000
1000 ifr=4thensc=sc+120:c$=" straight":goto1130
1010 ifk=7thensc=sc+10:c$=" one pair":goto1130
1020 ifk=9thensc=sc+30:c$=" two pair":goto1130
1030 ifk=11thensc=sc+60:c$=" 3 of a kind":goto1130
1040 ifk=13thensc=sc+100:c$=" full house":goto1130
1050 ifk=17thensc=sc+160:c$=" 4 of a kind":goto1130
1060 ifh2(a)=14andr=3andcs=28thensc=sc+120:c$=" straight":gosub890:goto1130
1070 return
1080 ifr=4then1110
1090 ifh2(a)=14andcs=28thensc=sc+300:c$=" str flush":goto1130
1100 sc=sc+50:c$=" flush":goto1130
1110 ifh2(a)=14thensc=sc+400:c$=" royal flush":goto1130
1120 sc=sc+300:c$=" str flush"
1130 forx=1to8:printchr$(19)chr$(144)""b$c$:sys49396:fort=1to75:next
1140 printchr$(19)chr$(5)""b$c$:sys49422:fort=1to75:next:next
1150 printchr$(19)b$" ":gosub430:return
1160 data255,255,255,255,255,255,255,0,1,3
1170 data7,15,31,63,127,255,128,192,224,240
1180 data248,252,254,255,127,63,31,15,7,3
1190 data1,0,254,252,248,240,224,192,128,0
1200 data0,0,0,0,0,0,0,0,0,28
1210 data62,127,255,255,255,127,0,56,124,254
1220 data255,255,255,254,63,31,15,7,3,1
1230 data0,0,252,248,240,224,192,128,0,0
1240 data0,3,15,31,31,15,3,57,0,192
1250 data240,248,248,240,192,156,127,255,255,127
1260 data57,1,3,0,254,255,255,254,156,128
1270 data192,0,0,1,3,7,15,31,63,127,0
1280 data128,192,224,240,248,252,254,255,255,255,127
1290 data57,1,3,0,255,255,255,254,156,128,192,0
1300 data155,2,166,2,170,0,187,0,178,179,180
1310 data181,182,183,184,185,177,138,145,139,129
1320 data1024,1029,1034,1039,1044,1224,1229,1234
1330 data1239,1244,1424,1429,1434,1439,1444,1624,1629
1340 data1634,1639,1644,1824,1829,1834,1839,1844,1254
1350 data169,95,133,251,169,64,133,252,32,72
1360 data192,76,99,192,169,159,133,251,169,128
1370 data133,252,32,72,192,76,99,192,169,223
1380 data133,251,169,192,133,252,32,72,192,76
1390 data99,192,169,0,133,10,162,30,202,134
1400 data79,32,0,192,32,79,192,160,41,138
1410 data105,60,145,253,32,225,192,224,5,208
1420 data233,96,169,0,133,2,76,83,192,169
1430 data41,133,2,24,189,55,3,101,2,133
1440 data253,189,82,3,105,0,133,254,96,160
1450 data4,165,252,145,253,136,208,251,32,131
1460 data192,162,4,160,4,165,251,145,253,136
1470 data208,251,32,131,192,202,208,241,166,79
1480 data96,24,165,253,105,40,133,253,165,254
1490 data105,0,133,254,96,32,79,192,160,0
1500 data165,251,145,253,201,177,240,43,169,164
1510 data133,2,32,83,192,165,251,145,253,169
1520 data82,133,2,32,83,192,160,0,165,252
1530 data145,253,105,1,200,145,253,105,1,160
1540 data40,145,253,105,1,200,145,253,76,225
1550 data192,200,169,176,145,253,169,162,133,2
1560 data32,83,192,165,251,145,253,169,176,200
1570 data145,253,76,169,192,134,79,32,72,192
1580 data24,165,254,105,212,133,254,165,10,133
1590 data251,76,108,192,160,5,190,114,3,224
1600 data0,240,11,132,78,169,1,133,10,32
1610 data227,192,164,78,136,192,0,208,233,96
1620 data160,5,190,114,3,224,0,240,12,132
1630 data78,189,115,3,133,10,32,227,192,164
1640 data78,136,192,0,208,232,96,160,249,185
1650 data0,216,153,0,128,185,250,216,153,250
1660 data128,185,244,217,153,244,129,185,238,218
1670 data153,238,130,136,192,255,208,227,160,249
1680 data169,0,153,0,216,153,250,216,153,244
1690 data217,153,238,218,136,192,255,208
1700 data239,96,160,249,185,0,128,153,0,216
1710 data185,250,128,153,250,216,185,244,129,153
1720 data244,217,185,238,130,153,238,218,136,192
1730 data255,208,227,96